 
Imports System
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Windows.Forms
Imports System.Runtime.InteropServices



' class that exposes needed windows GDI Functions.
Public Class Win32


    Public Enum Bool
        bFalse = 0
        bTrue = 1
    End Enum



    <StructLayout(LayoutKind.Sequential)>
    Public Structure Point

        Public x As Int32
        Public y As Int32

        Public Sub New(x As Int32, y As Int32)
            Me.x = x
            Me.y = y
        End Sub
    End Structure


    <StructLayout(LayoutKind.Sequential)>
    Public Structure Size
        Public cx As Int32
        Public cy As Int32

        Public Sub New(cx As Int32, cy As Int32)
            Me.cx = cx
            Me.cy = cy
        End Sub
    End Structure



    <StructLayout(LayoutKind.Sequential, Pack:=1)>
    Structure ARGB

        Public Blue As Byte
        Public Green As Byte
        Public Red As Byte
        Public Alpha As Byte
    End Structure



    <StructLayout(LayoutKind.Sequential, Pack:=1)>
    Public Structure BLENDFUNCTION
        Public BlendOp As Byte
        Public BlendFlags As Byte
        Public SourceConstantAlpha As Byte
        Public AlphaFormat As Byte
    End Structure



    Public Const ULW_COLORKEY As Int32 = &H1
    Public Const ULW_ALPHA As Int32 = &H2
    Public Const ULW_OPAQUE As Int32 = &H4

    Public Const AC_SRC_OVER As Byte = &H0
    Public Const AC_SRC_ALPHA As Byte = &H1


    <DllImport("user32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function UpdateLayeredWindow(hwnd As IntPtr, hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, hdcSrc As IntPtr, ByRef pprSrc As Point, crKey As Int32, ByRef pblend As BLENDFUNCTION, dwFlags As Int32) As Bool

    End Function

    <DllImport("user32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function GetDC(hWnd As IntPtr) As IntPtr

    End Function
    <DllImport("user32.dll", ExactSpelling:=True)>
    Public Shared Function ReleaseDC(hWnd As IntPtr, hDC As IntPtr) As Integer
    End Function
    <DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function CreateCompatibleDC(hDC As IntPtr) As IntPtr

    End Function
    <DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function DeleteDC(hdc As IntPtr) As Bool

    End Function
    <DllImport("gdi32.dll", ExactSpelling:=True)>
    Public Shared Function SelectObject(hDC As IntPtr, hObject As IntPtr) As IntPtr

    End Function
    <DllImport("gdi32.dll", ExactSpelling:=True, SetLastError:=True)>
    Public Shared Function DeleteObject(hObject As IntPtr) As Bool

    End Function
End Class

Public MustInherit Class PerPixelAlphaForm
    Inherits Form

    Public Sub New()
        FormBorderStyle = FormBorderStyle.None
    End Sub
    Public Overloads Sub SetBitmap(bmp As Bitmap)
        SetBitmap(bmp, 255)
    End Sub
    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim cp As CreateParams = MyBase.CreateParams
            If Not DesignMode then cp.ExStyle = cp.ExStyle Or &H80000
            Return cp
        End Get
    End Property
    
    Public Overloads Sub SetBitmap(bmp As Bitmap, Opacity As Byte)

        If bmp.PixelFormat <> PixelFormat.Format32bppArgb Then
            Throw New ApplicationException("The Bitmap must be a 32bpp with a Alpha Channel")
        End If

        'Create Compatible DC with the screem
        'Select bitmap with 32bpp with alpha into the compatible DC
        'call UpdateLayeredWindow

        Dim ScreenDC As IntPtr = Win32.GetDC(IntPtr.Zero)
        Dim MemDC As IntPtr = Win32.CreateCompatibleDC(ScreenDC)
        Dim hBitmap As IntPtr = IntPtr.Zero
        Dim oldBitmap As IntPtr = IntPtr.Zero
        Try
            hBitmap = bmp.GetHbitmap(Color.FromArgb(0))
            oldBitmap = Win32.SelectObject(MemDC, hBitmap)
            Dim thesize As Win32.Size = New Win32.Size(bmp.Width, bmp.Height)
            Dim pointSource As Win32.Point = New Win32.Point(0, 0)
            Dim topPos As Win32.Point = New Win32.Point(Left, Top)
            Dim blend As Win32.BLENDFUNCTION = New Win32.BLENDFUNCTION()
            blend.BlendOp = Win32.AC_SRC_OVER
            blend.BlendFlags = 0
            blend.SourceConstantAlpha = Opacity
            blend.AlphaFormat = Win32.AC_SRC_ALPHA
            Win32.UpdateLayeredWindow(Handle, ScreenDC, topPos, New Win32.Size(Size.Width, Size.Height), MemDC, pointSource, 0, blend, Win32.ULW_ALPHA)

        Catch ex As Exception

        Finally
            Win32.ReleaseDC(IntPtr.Zero, ScreenDC)
            If Not hBitmap = IntPtr.Zero Then
                Win32.SelectObject(MemDC, oldBitmap)
                Win32.DeleteObject(hBitmap)
            End If
            Win32.DeleteDC(MemDC)

        End Try


    End Sub
End Class
